MacFormat 1995 January/macformat-020.iso/Shareware City/Applications/Alpha.5.96 folder/Tcl/SystemCode/bibtex.tcl

Text File | 1994-09-19 | 29.3 KB | 956 lines | [TEXT/ALFA]

###########################################################################
# bibtex.tcl
#
# This file contains a package of Tcl routines that add support for using
# and maintaining BibTeX citation databases to Alpha.
#
# See the accompanying file, "BibTeX Help", for a complete description.
#
###########################################################################
# Notes:
#
# By default, only the required fields are included when a new bib entry
# is created.  You can select any other set of fields to be used by adding
# an appropriate entry to the 'myFld' array, following the example for the
# Article entry, further below.  You shouldn't change the 'rqdFld' or
# 'optFld' arrays, since these will (some day) be used for syntax checking.
#
###########################################################################
# written by Tom Pollard ([e-mail])
#
# Version History
#
# 1.9 (9/94)    'getFields' should now correctly parse any legal entry.
#                'language' field now included.
#                Default values for new fields (eg 'language') may be defined
#                'preferBraces' replaced by 'fieldBraces' and 'entryBraces'.
#                line-wrapping is done on reformatted entries.
#                '@string' entries preserved in sorts.
#                text before first entry and after last entry are preserved
#                    by sorts.
# 1.8 (8/94)    "getEntry" now recognizes parens as entry delimiters
# 1.7 (8/94)    Bug fixes and accomodations to latex.tcl v2.2
#               Template insertion streamlined
#                Choose multiple fields at a time from list dialog
# 1.6 (8/94)    "preferBraces" allows braces or quotes to be default for
#                   new or reformatted entries,
#               Menu built using $entryNames and $fieldNames,
#               'sortByAuthors' can now sort using last author first,
#                   and is a bit faster,
#               'formatEntry' rewrites entries in canonical format,
#               More customization of canonical format allowed ('indentString')
#               Bib mode definition adapted to Alpha 5.90.
# 1.5 (7/94)    "sortByAuthors" is now robust (I think),
#               Mode of new windows now set correctly.
# 1.4 (7/94)    Added sorting by authors, but still only semi-functional,
#               Added regexp searching by field,
#               "getEntry" bugs fixed.
# 1.2 (7/94)    Bib mode definition adapted to Alpha 5.85,
#               Added bib-file marking (bibMarkFile),
#               Entry and field creation now controlled by data arrays.
# 1.1 (6/94)    Custom BibTeX icon,
#               Added simple search capability (matchingEntries).
# 1.0 (9/93)    First stable version.
#
###########################################################################
# This package was inspired by the LaTeX package (latex.tcl), written by
#
#    Richard T. Austin  <[e-mail]>  , and (currently),
#    Tom Scavo          <[e-mail]>
#
###########################################################################
###########################################################################
# BibTeX Key Bindings.
###########################################################################
# abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
#
bind 'b' <sz>    selectEntry "Bib"
bind 'n' <sz>    nextEntry "Bib"
bind 'p' <sz>    prevEntry "Bib"

bind 'f' <sz>    searchFields "Bib"
bind 'm' <sz>    searchEntries "Bib"
bind 'l' <sz>    formatEntry "Bib"

# tab stops:
bind    '\t'    nextTabStop    "Bib"
bind    '\t'    <s>     prevTabStop    "Bib"
bind  '\t'  <z>  {nthTabStop 0}  "Bib"
bind  '\t'  <c>  clearTabStops  "Bib"

###########################################################################
# Data Definitions
###########################################################################
###########################################################################
# Define the data arrays that contain the names of the required,
# optional, and preferred fields for each entry type.
#
# The index names of the rqdFld() array _define_ the valid entry types
# recognized by the program.
#
set rqdFld(article) {author title journal year}
set optFld(article) {volume number pages month note}
set myFld(article) {author title journal volume pages year note}

set rqdFld(book) {author title publisher year}
set optFld(book) {editor volume number series address edition month note}

set rqdFld(booklet) {title}
set optFld(booklet) {author howpublished address month year note}

set rqdFld(conference) {author title booktitle year}
set optFld(conference) {editor volume number series pages organization publisher address month note}

set rqdFld(inBook) {author title chapter publisher year}
set optFld(inBook) {editor pages volume number series address edition month type note}

set rqdFld(inCollection) {author title booktitle publisher year}
set optFld(inCollection) {editor volume number series type chapter pages address edition month note}

set rqdFld(inProceedings) {author title booktitle year}
set optFld(inProceedings) {editor volume number series pages organization publisher address month note}

set rqdFld(manual) {title}
set optFld(manual) {author organization address edition year month note}

set rqdFld(mastersThesis) {author title school year}
set optFld(mastersThesis) {address month note type}

set rqdFld(misc) {}
set optFld(misc) {author title howpublished year month note}

set rqdFld(phdThesis) {author title school year}
set optFld(phdThesis) {address month type note}

set rqdFld(proceedings) {title year}
set optFld(proceedings) {editor volume number series publisher organization address month note}

set rqdFld(techReport) {author title institution year}
set optFld(techReport) {type number address month note}

set rqdFld(unpublished) {author title note}
set optFld(unpublished) {year month}

set entryNames [lsort [array names rqdFld]]
set customEntries [lsort [array names myFld]]

###########################################################################
# Define an array of flags indicating whether the data a given field
# type should be quoted.  The actual characters used to quote the field are
# given by $bibOpenQuote and $bibCloseQuote, which are set by the routine
# 'bibFieldDelims' according to the flag $fieldBraces.
#
# Note that the index names of the useBrace() array _define_ the valid
# field types recognized by the program.
#
set useBrace(address)    1
set useBrace(annote)    1
set useBrace(author)     1
set useBrace(booktitle)    1
set useBrace(chapter)    0
set useBrace(edition)    1
set useBrace(editor)    1
set useBrace(howpublished)    1
set useBrace(institution)    1
set useBrace(journal)    1
set useBrace(key)    1
set useBrace(language)    1
set useBrace(month)    1
set useBrace(note)    1
set useBrace(number)    0
set useBrace(organization)    1
set useBrace(pages)    0
set useBrace(publisher)    1
set useBrace(school)    1
set useBrace(series)    1
set useBrace(title)    1
set useBrace(type)    1
set useBrace(volume)    0
set useBrace(year)    0

set fieldNames [lsort [array names useBrace]]
###########################################################################
# Default values for newly created fields
#
set defFldVal(language) "german"

set fieldDefs [lsort [array names defFldVal]]

###########################################################################
# BibTeX-mode mode definition
###########################################################################
newModeVar Bib suffixString    { \\\\} 0
newModeVar Bib prefixString    {% } 0
newModeVar Bib wordWrap        {0} 1
newModeVar Bib wordBreak        {[a-zA-Z0-9]+} 0
newModeVar Bib wordBreakPreface        {[^a-zA-Z0-9]} 0
newModeVar Bib funcExpr        {[ \t]*@[a-zA-Z]+.([a-zA-Z0-9]+)} 0
newModeVar Bib optionIsMeta    {1} 1

newModeVar Bib overwriteBuffer {1} 1
newModeVar Bib fieldBraces {1} 1
newModeVar Bib entryBraces {1} 1
newModeVar Bib indentString {   } 0

set bibtexKeyWords {address annote author booktitle
    chapter city crossref edition editor howpublished institution
    journal key language month note number organization
    publisher pages school series title type
    volume year}
regModeKeywords -e {%} -m {@} -c red -k blue Bib $bibtexKeyWords
unset bibtexKeyWords

###########################################################################
# BibTeX Menu Definition.
###########################################################################
set bibtexMenu "•136"

proc bibtex {} {
    global bibtexPath
    set name [checkRunning BibTeX BIBt bibtexPath]
    if {![string length $name]} return
    switchTo $name
}

proc makeindex {} {
    global makeindexPath
    set name [checkRunning MakeIndex Midx makeindexPath]
    if {![string length $name]} return
    switchTo $name
}

menu -n $bibtexMenu {
    "bibtex"
    "(-)"
    {menu -n Entries -p makeEntry {}
    }
    {menu -n Fields -p makeField {}
    }
    "(-)"
    "selectEntry"
    "nextEntry"
    "prevEntry"
    "formatEntry"
    "(-)"
    "searchEntries"
    "searchFields"
    {menu -n sortBy... -p bibSortProc {
        "citeKey"
        "firstAuthor"
        "lastAuthor"
        }
    }
}

menu -n Entries -p makeEntry [concat $entryNames {
        "(-)"
        "customEntry"
        } ]

menu -n Fields -p makeField [concat $fieldNames {
        "(-)"
        "customField"
        "multipleFields"
        } ]

###########################################################################
# Menu command procs
###########################################################################

proc makeField {menu item} {
    global fieldNames
    bibFormatSetup

    if {$item == "multipleFields"} then {
        set flds [listpick -l -L {author year} -p "Pick desired fields:" $fieldNames]
        if {[llength flds]} {
            set lines {}
            foreach fld $flds {
                append lines [newField $fld]
            }
        } else {
            return
        }
    } else {
        set lines [newField $item]
    }

    set pos0 [nextLineStart [getPos]]
    goto $pos0
    insertText $lines
    goto $pos0
    nextTabStop
}

proc makeEntry {menu item} {
    bibFormatSetup
    newEntry $item
}

###########################################################################
#  Return the bounds of the bibliographic entry surrounding the current
#  position.
#
proc getEntry {pos} {

    set pos1 [search -f 0 -r 1 -n {[     ]*@[a-zA-Z]*[\{\(]} $pos ]
    if {$pos1 == ""} then {
        set begPos [nextLineStart $pos]
        set endPos $begPos
    } else {
        set begPos [lineStart [lindex $pos1 0]]
        set pos0 [lindex $pos1 1]
#         set pos1 [matchIt "\{" $pos0]]
        set openBrace [getText [expr $pos0-1] $pos0 ]
        set pos1 [matchIt $openBrace $pos0]]
        set endPos [nextLineStart $pos1]
    }
    return [list $begPos $endPos]
}

###########################################################################
#  Advance to the next bibliographic entry.
#
proc nextEntry {} {
    saveVars

    set pos0 [lindex [getEntry [getPos]] 1]

    set pos [search -f 1 -r 1 -n {[     ]*@[a-zA-Z]+[\{\(]} $pos0 ]
    if {$pos == ""} then {
       set nextPos $pos0
    } else {
       set nextPos [lindex $pos 0]
    }
    goto $nextPos
}

###########################################################################
#  Go back to the previous bibliographic entry.
#
proc prevEntry {} {
    saveVars

    set pos0 [lindex [getEntry [getPos]] 0]
    set pos1 $pos0
    if {$pos1 > 0} {incr pos1 -1}

    set pos [search -f 0 -r 1 -n {[     ]*@[a-zA-Z]+[\{\(]} $pos1 ]
    if {$pos == ""} then {
       set nextPos $pos0
    } else {
       set nextPos [lindex $pos 0]
    }
    goto $nextPos
}

###########################################################################
#  Select (highlight) the current bibliographic entry.
#
proc selectEntry {} {
    set pos [getEntry [getPos]]
    select [lindex $pos 0] [lindex $pos 1]
}

###########################################################################
#  Create a new bibliographic entry with its required fields.
#
proc newEntry {entryName} {
    global  entryNames customEntries fieldNames rqdFld optFld myFld defFldVal
    global bibOpenEntry bibCloseEntry
    goto [lindex [getEntry [getPos]] 1]
    if {$entryName == "customEntry"} {
        set lines "@•$bibOpenEntry•,\r"
        set theFields [listpick -l -L {author} -p "Pick desired fields:" $fieldNames]
    } else {
        set lines "@${entryName}$bibOpenEntry•,\r"
        if {[lsearch -exact $customEntries $entryName] >= 0 && [llength $myFld($entryName)]} {
            set theFields $myFld($entryName)
        } elseif {[lsearch -exact $entryNames $entryName] >= 0} {
            set theFields $rqdFld($entryName)
        } else {
            set theFields {}
        }
    }
    set theTop [lineStart [getPos]]
    foreach field $theFields {
        catch {append lines [newField $field]}
    }
    append lines "$bibCloseEntry\r"
    insertText $lines
    goto $theTop
    nextTabStop
}

###########################################################################
#  Create a new field within the current bibliographic entry
#
proc newField {fieldName} {
    global fieldNames useBrace bibOpenQuote bibCloseQuote bibIndent
    global fieldDefs defFldVal
    if {[lsearch -exact $fieldNames $fieldName] >= 0} {
        set needBraces $useBrace($fieldName)
    } else {
        set needBraces 1
    }

    if {[lsearch -exact $fieldDefs $fieldName] >= 0} {
        set val $defFldVal($fieldName)
    } else {
        set val "•"
    }

    if {$needBraces || $fieldName == "customField"} {
        set result "$bibIndent$fieldName =      ${bibOpenQuote}${val}${bibCloseQuote},\r"
    } else {
        set result "$bibIndent$fieldName =      $val,\r"
    }
    return $result
}

proc bibFormatSetup {} {
    global bibOpenQuote bibCloseQuote bibIndent BibmodeVars
    global bibOpenEntry bibCloseEntry
    bibFieldDelims
    bibEntryDelims
    set bibIndent $BibmodeVars(indentString)
    regsub {\\t} $bibIndent {    } bibIndent
}

###########################################################################
#  Find all entries that match a given regular expression and copy them to
#  a new buffer.
#
proc searchEntries {} {
    if [catch {prompt "Regular expression:" ""} reg] return
    if {![string length $reg]} return
    set reg ^.*$reg.*$

    set matches [findEntries $reg]
    if {[llength $matches] >0} {
        writeEntries $matches 0
    } else {
        message "No matching entries were found"
    }
}

###########################################################################
#  Find all entries in which the indicated field matches a given regular
#  expression and copy them to a new buffer.
#
proc searchFields {} {
    global fieldNames
    if {[catch {eval prompt {{Field name:}} "author" {Fields} $fieldNames} fld]} return
    if {![string length $fld]} return

    if {[catch {prompt "Regular expression:" ""} reg]} return
    if {![string length $reg]} return

    set matches [findEntries $reg]
    if {[llength $matches] == 0} {
        return "No matching entries were found"
    }

    set vals {}
    foreach hit $matches {
        set pos [lindex $hit  1]
        set top [lindex $hit 2]
        set bottom [lindex $hit 3]
        if {[getFldName $pos $top] == $fld} {
            lappend vals [list $top $bottom]
        }
    }

    if {[llength $vals] >0} {
        writeEntries $vals 0
    } else {
        message "No matching entries were found"
    }

}

###########################################################################
# Sort all of the entries one of various criteria.
#
proc bibSortProc {menu item} {
    if {$item == "citeKey"} {
        sortByCiteKey
    } elseif  {$item == "firstAuthor"} {
        sortByAuthors 0
    } elseif  {$item == "lastAuthor"} {
        sortByAuthors 1
    }
}

###########################################################################
# Sort all of the entries in the file alphabetically by author.
#
proc sortByAuthors {lastAuthorFirst} {
    set matches [findEntries {^[    ]*@[^\{\(]+[\{\(]([-A-Za-z0-9_:\.]+)} ]
    set vals {}
    set others {}
    set beg [maxPos]
    set end 0
    foreach hit $matches {
        set pos [lindex $hit 1]
        set top [lindex $hit 2]
        set bottom [lindex $hit 3]
        set entry [getText $top $bottom]
        regsub -all "\[\n\r\]+" $entry { } entry
        regsub -all "\[ \t\]\[ \t\]+" $entry { } entry
        if {![catch {getFldValue $entry author} fldval]} {
            lappend vals [list [authSortKey $fldval $lastAuthorFirst] $top $bottom]
        } else {
            lappend others [list $pos $top $bottom]
        }
        if {$top < $beg} {set beg $top}
        if {$bottom > $end} {set end $bottom}
    }
    set result [concat $others [lsort $vals]]
    if {[llength $result] >0} {
        writeEntries $result 1 $beg $end
    } else {
        message "No results of author sort !!??"
    }
}

###########################################################################
# Create a sort key from an author list.  When sorting entries by author,
# performing the sort using keys should be faster than reparsing the author
# lists for every comparison (the old method :-( ).
#
proc authSortKey {authList lastAuthorFirst} {
    set pat1 {\\.\{([A-Za-z])\}}
    set pat2 {\{([^\{\}]+) ([^\{\}]+)\}}

# Remove enclosing braces, quotes, or whitespace
    set auths %[string trim $authList {{}"     }]&
# Remove TeX codes for accented characters
    regsub -all $pat1 $auths {\1} auths
# Concatenate strings enclosed in braces
    while {[regsub -all $pat2 $auths {{\1\2}} auths]} {}
# Remove braces (curly and square)
    regsub -all {[][\{\}]} $auths {} auths
#    regsub -all {,} $auths { ,} auths
# Replace 'and's with begin-name/end-name delimiters
    regsub -all {[ \t]and[ \t]} $auths { \&% } auths
# Put last name first in name fields without commas
    regsub -all {%([^\&,]+) ([^\&, ]+) *\&} $auths {%\2,\1\&} auths
# Remove begin-name delimiters
    regsub -all {%} $auths {} auths
# Remove whitespace surrounding name separators
    regsub -all {[ \t]*\&[ \t]*} $auths {\&} auths
# Replace whitespace separating words with shrieks
    regsub -all {[ \t,]+} $auths {!} auths
# If desired, move last author to head of sort key
    if {$lastAuthorFirst} {
        regsub {(.*)&([^&]+)} $auths {\2!\1} auths
    }

    return $auths
}

###########################################################################
# Sort all of the entries in the file alphabetically by their cite-keys.
#
proc sortByCiteKey {} {

    set matches [findEntries {^[    ]*@[^\{\(]+[\{\(]([-A-Za-z0-9_:\.]+)} ]
    set begEntries [maxPos]
    set endEntries 0
    foreach hit $matches {
        set beg [lindex $hit 0]
        set end [lindex $hit 1]
        set top [lindex $hit 2]
        set bottom [lindex $hit 3]
        regexp {[\{\(]([-A-Za-z0-9_:\.]+)} [getText $beg $end] allofit citekey
        lappend vals [list $citekey $top $bottom]]
        if {$top < $begEntries} {set begEntries $top}
        if {$bottom > $endEntries} {set endEntries $bottom}
    }

    set result [lsort $vals]
    if {[llength $result] >0} {
        writeEntries $result 1 $begEntries $endEntries
    } else {
        message "No results of cite-key sort !!??"
    }
}

###########################################################################
# Search for all entries matching a given regular expression.  The results
# are returned in a list, each element of which is a list of four integers:
# the beginning and end of the matching entry and the beginning and end of
# the matching string.  Adapted from "matchingLines" in "misc.tcl".
#
proc findEntries {reg} {
    if {![string length $reg]} return

    set pos 0
    set result {}
    while {![catch {search -f 1 -r 1 -m 0 -i 1 $reg $pos} mtch]} {
        lappend result [concat  $mtch [getEntry [lindex $mtch 0]]]
        set pos [lindex $mtch 1]
    }
    return $result
}

###########################################################################
#  Return a list containing the data for the current entry, indexed by
#  the parameter names, e.g., "author", "year", etc.  Index names for the
#  entry type and cite-key are "type" and "citekey".
#
proc getFields {pos} {
#    set topPat {@([a-zA-Z]+)\{([A-Za-z0-9]+),}
    set topPat {[     ]*@([a-zA-Z]+)[\{\(]([-A-Za-z0-9_:\.]+)[     ]*,}
    set fldPat {[     ]*([a-zA-Z]+)[     ]*=[     ]*}

    set limits [getEntry $pos]
    set top [lindex $limits 0]
    set bottom [lindex $limits 1]

    set entry [getText $top $bottom]
    regsub -all "\[\n\r\]+" $entry { } entry
    regsub -all "\[ \t\]\[ \t\]+" $entry { } entry

    if {[regexp  -indices $topPat $entry mtch theType theKey ]} {
        lappend names type
        set type [string tolower [string range $entry [lindex $theType 0] [lindex $theType 1]]]
        lappend data [list $type]
        lappend names citekey
        set key [string range $entry [lindex $theKey 0] [lindex $theKey 1]]
        lappend data $key

        set entry [string range $entry [expr 1 + [lindex $mtch 1]] end]
        while {![catch {getField $entry} res]} {
            lappend names [string tolower [lindex $res 0]]
            lappend data [breakIntoLines [lindex $res 1]]
            set entry [lindex $res 2]
        }
        return [list $names $data]
    } else {
        error "Invalid entry"
    }
}

###########################################################################
#  Extract the next data field from the entry, passed as a single string.
#  This version tries to be completely general, allowing nested braces
#  within data fields and ignoring escaped delimiters (mainly \").  It's
#  probably unnecessarily slow as a result :-(
#
proc getField {entry} {
    set fldPat {[     ]*([^ =,]+)[     ]*=[     ]*}
    set slash "\\"
    set qslash "\\\\"

    set ok [regexp -indices -nocase $fldPat $entry mtch sub1]
    if {$ok} {
        set name [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
        set pos [expr [lindex $mtch 1] + 1]
        set delim [string range $entry $pos $pos]
        set entry [string range $entry [expr 1 + $pos] end]

        if {$delim == {"}} {
            set ck $qslash
            set fld ""
            while {$ck == $qslash} {
                set ok [regexp -indices {^([^"]*)"} $entry mtch sub1]
                if {$ok} {
                    append fld [string range $entry [lindex $mtch 0] [lindex $mtch 1]]
                    set ck $slash[string range $entry [lindex $sub1 1] [lindex $sub1 1]]
                    set pos [expr 1 + [lindex $mtch 1]]
                    set entry [string range $entry $pos end]
                } else {
                    error "Couldn't match quote as field delimiter"
                }
            }
            set pos [expr [string length $fld] - 2]
            set fld [string range $fld 0 $pos]
            set ok [regexp -indices {^([^,]*),} $entry mtch sub1]
            if {$ok} {
                set entry [string range $entry [expr 1 + [lindex $mtch 1]] end]
            }

        } elseif {$delim == "\{"} {

            set nopen 1
            set nclose 0
            set fld ""
            while {$nopen - $nclose != 0} {
                set ok [regexp -indices "^\[^\}\]*\}" $entry mtch]
                if {$ok} {
                    append fld [string range $entry [lindex $mtch 0] [lindex $mtch 1]]
                    set entry [string range $entry [expr 1 + [lindex $mtch 1]] end]
                    set nopen [llength [split $fld "\{"]]
                    incr nclose
                } else {
                    error "Couldn't match brace as field delimiter"
                }
            }
            set pos [expr [string length $fld] - 2]
            set fld [string range $fld 0 $pos]
            set ok [regexp -indices {^([^,]*),} $entry mtch sub1]
            if {$ok} {
                set entry [string range $entry [expr 1 + [lindex $mtch 1]] end]
            }

        } else {

            set entry ${delim}${entry}
            set ok [regexp -indices {^([^,]*),?} $entry mtch sub1]
            if {$ok} {
                set fld [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
                set pos [expr 1 + [lindex $mtch 1]]
                set entry [string range $entry $pos end]
                set entry [string trimleft $entry ","]
            } else {
                set fld [string trimright $entry]
                set entry ""
            }
        }
        return [list $name $fld $entry]
    } else {
        error "No more fields in this entry"
    }
}

###########################################################################
# Extract the data from the indicated field of an entry, which is passed
# as a single string.  This version tries to be completely general,
# allowing nested braces within data fields and ignoring escaped
# delimiters.  (derived from proc getField).
#
proc getFldValue {entry fldname} {
    set fldPat "\[     \]*${fldname}\[     \]*=\[     \]*"
    set slash "\\"
    set qslash "\\\\"

    set ok [regexp -indices -nocase $fldPat $entry mtch]
    if {$ok} {
        set pos [expr [lindex $mtch 1] + 1]
        set delim [string range $entry $pos $pos]
        set entry [string range $entry [expr 1 + $pos] end]

        if {$delim == {"}} {
            set ck $qslash
            set fld ""
            while {$ck == $qslash} {
                set ok [regexp -indices {^([^"]*)"} $entry mtch sub1]
                if {$ok} {
                    append fld [string range $entry [lindex $mtch 0] [lindex $mtch 1]]
                    set ck $slash[string range $entry [lindex $sub1 1] [lindex $sub1 1]]
                    set pos [expr 1 + [lindex $mtch 1]]
                    set entry [string range $entry $pos end]
                } else {
                    error "Couldn't match quote as field delimiter"
                }
            }
            set fld [string trimright $fld {\"}]

        } elseif {$delim == "\{"} {

            set nopen 1
            set nclose 0
            set fld ""
            while {$nopen - $nclose != 0} {
                set ok [regexp -indices "^\[^\}\]*\}" $entry mtch]
                if {$ok} {
                    append fld [string range $entry [lindex $mtch 0] [lindex $mtch 1]]
                    set entry [string range $entry [expr 1 + [lindex $mtch 1]] end]
                    set nopen [llength [split $fld "\{"]]
                    incr nclose
                } else {
                    error "Couldn't match brace as field delimiter"
                }
            }
            set fld [string trimright $fld "\}"]

        } else {

            set entry ${delim}${entry}
            set ok [regexp -indices {^([^,]*),?} $entry mtch sub1]
            if {$ok} {
                set fld [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
                set pos [expr 1 + [lindex $mtch 1]]
                set entry [string range $entry $pos end]
            } else {
                set fld [string trimright $entry]
            }
        }

        return $fld

    } else {
        error "field not found"
    }
}

###########################################################################
# Parse the entry around position "pos" and rewrite it to the original
# buffer in a canonical format
#
proc formatEntry {} {
    global useBrace bibOpenQuote bibCloseQuote
    global bibOpenEntry bibCloseEntry bibIndent

    bibFormatSetup

    set pos [getPos]
    set limits [getEntry $pos]
    set top [lindex $limits 0]
    set bottom [lindex $limits 1]
    if {![catch {getFields $pos} flds]} {
        set names [lindex $flds 0]
        set vals [lindex $flds 1]
        set nfld [llength $names]
        set lines {}

        append lines "@[lindex $vals 0]${bibOpenEntry}[lindex $vals 1],\r"
        for {set ifld 2} {$ifld < $nfld} {incr ifld} {
            set nm [lindex $names $ifld]
            set vl [lindex $vals $ifld]

            set pref "${bibIndent}$nm = "
            regsub -all {.} $pref { } ind

            set ok [expr ! [catch {set useit $useBrace($nm)}]]
            if { $ok && $useit == 0 && [isNum $vl]} {
                set vl "$vl,"
            } else {
                set vl "${bibOpenQuote}${vl}${bibCloseQuote},"
            }

            set pieces [split $vl "\r"]
            append lines "$pref    [lindex $pieces 0]\r"
            foreach piece [lrange $pieces 1 end] {
            append lines "$ind    $piece\r"
            }
        }
        append lines "$bibCloseEntry\r"
        deleteText $top $bottom
        goto $top
        insertText $lines
    }
}

###########################################################################
# Get the name of the field that starts before the given position,
# $pos.  The positions $top and $bottom restrict the range of the
# search for the beginning and end of the field; typically, $top and
# $bottom will be the limits of a given entry.
#
proc getFldName {pos top} {
    set fldPat {[     ]*([a-zA-Z]+)[     ]*=[     ]*}
    if {![catch {search -f 0 -r 1 -m 0 -i 1 -limit $top "^$fldPat" $pos} mtch]} {
        set theText [eval getText $mtch]
        regexp -nocase $fldPat $theText allofit fldnam
        return $fldnam
    } else {
        return {}
    }
}

###########################################################################
#  Set the quote characters for quoted fields based on the value of the
#  flag $bibUseBrace
#
proc bibFieldDelims {} {
    global BibmodeVars bibOpenQuote bibCloseQuote
    if {$BibmodeVars(fieldBraces)} then {
        set bibOpenQuote "{"
        set bibCloseQuote "}"
    } else {
        set bibOpenQuote {"}
        set bibCloseQuote {"}
    }
}

proc bibEntryDelims {} {
    global BibmodeVars bibOpenEntry bibCloseEntry
    if {$BibmodeVars(entryBraces)} then {
        set bibOpenEntry "{"
        set bibCloseEntry "}"
    } else {
        set bibOpenEntry "("
        set bibCloseEntry ")"
    }
}

proc isBibFile {} {
    set fileName [lindex [winNames -f] 0]
    set ext [file extension $fileName]
    return [string match ".bib" [string tolower $ext]]
}

proc hasNumVal {str} {
    expr ! [catch {expr $str}]
}
proc isNum {str} {
    regexp {^[     ]*[0-9]+[     ]*$} $str mtch
}

###########################################################################
# Take a list of lists that point to selected entries and copy these into
# a new window.  The beginning and ending positions for each entry must
# be the last two items in each sublist.  The rest of the sublists are
# ignored.  It is assumed that each sublist has the same number of items.
#
proc writeEntries {entryPos nondestructive {beg {0}} {end {-1}}} {
        global BibmodeVars
        if {$end < 0} {set end [maxPos]}
        set llen [expr [llength [lindex $entryPos 0]] - 1]
        set llen1 [expr $llen-1]
        foreach entry $entryPos {
            set limits [lrange $entry $llen1 $llen]
            append lines [eval getText $limits]
        }
        set overwriteOK [expr $nondestructive || ! [isBibFile]]
        if {$BibmodeVars(overwriteBuffer) && $overwriteOK} {
            deleteText $beg $end
            insertText $lines
            goto $beg
        } else {
            set begLines [getText 0 [lineStart $beg]]
            set endLines [getText [nextLineStart $end] [maxPos]]
            new -n {*BibTeX Sort/Search*}
            newMode Bib
            insertText $begLines
            insertText $lines
            insertText $endLines
            goto $beg
            setWinInfo dirty 0
            catch shrinkWindow
        }
}

###########################################################################
# Set a named mark for each entry, using the cite-key name
#
proc BibMarkFile {} {
    set topPat {^[     ]*@[a-zA-Z]+[\{\(]([-A-Za-z0-9_:\.]+)}
    set pos 0
    while {![catch {search -f 1 -r 1 -m 0 -i 0 $topPat $pos} res]} {
        set start [lindex $res 0]
        set end [nextLineStart $start]
        set text [getText $start $end]
        set lab ""
        if {[regexp $topPat $text mtch entryTag]} {
            set lab $entryTag
            setNamedMark $lab [lineStart [expr $start - 1]] $start $start
        }
        set pos $end
    }
}

proc dummyBibTeX {} {
}

############################################################################
# Cause latex.tcl to be loaded by calling a dummy procedure defined in that
# file.  This is necessary to get the TeX menu.
#

dummyTeX

#